home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / sbprolog / amiga / c_src2_5.zoo / loader.c < prev    next >
C/C++ Source or Header  |  1990-06-03  |  19KB  |  640 lines
  1. /************************************************************************
  2. *                                    *
  3. * The SB-Prolog System                            *
  4. * Copyright SUNY at Stony Brook, 1986; University of Arizona, 1987    *
  5. *                                    *
  6. ************************************************************************/
  7.  
  8. /*-----------------------------------------------------------------
  9. SB-Prolog is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY.  No author or distributor
  11. accepts responsibility to anyone for the consequences of using it
  12. or for whether it serves any particular purpose or works at all,
  13. unless he says so in writing.  Refer to the SB-Prolog General Public
  14. License for full details.
  15.  
  16. Everyone is granted permission to copy, modify and redistribute
  17. SB-Prolog, but only under the conditions described in the
  18. SB-Prolog General Public License.   A copy of this license is
  19. supposed to have been given to you along with SB-Prolog so you
  20. can know your rights and responsibilities.  It should be in a
  21. file named COPYING.  Among other things, the copyright notice
  22. and this notice must be preserved on all copies. 
  23. ------------------------------------------------------------------ */
  24.  
  25. /* loader.c */
  26.  
  27. /* modification history  ----------
  28.      07/16/89 - index.h now included
  29.            added SEPARATOR definition 
  30. ************************/           
  31.  
  32. #include "sim.h"
  33. #ifdef AMIGA
  34. #include "index.h"
  35. #endif
  36. #include "inst.h"
  37. #include "aux.h"
  38.  
  39.  
  40. #define get_data(x,y)     (y - fread(x, sizeof(*x), y, fp) )
  41. #define st_ptrptrpsc(i_addr)  *((pw *)i_addr) = reloc_table[*(pw)i_addr];
  42. #define st_ptrpsc(i_addr)  *((pw)i_addr) = *reloc_table[*(pw)i_addr];
  43.  
  44. #ifdef AMIGA
  45. #define SEPARATOR '!' /* character to separate search paths */
  46. #else 
  47. #define SEPARATOR ':' /* SIMPATH = '.../modlib:.../cmplib:...*/
  48. #endif
  49.  
  50. static pb inst_addr, hptr;
  51.  
  52. static pw reloc_table[500];
  53. static byte *last_text;
  54.  
  55. unsigned long eof_flag;
  56. unsigned long psc_bytes, text_bytes, index_bytes, magic;
  57. int (*load_routine[16])();
  58. static   FILE *fp;
  59. static byte perm = PERM;
  60. int inst_length[15] = { 0, 4, 6, 6, 2, 6, 6, 6, 6, 10, 6, 6, 2, 4, 10};
  61.  
  62.  
  63. /****************************************************************************/
  64. /*                                        */
  65. /* fix_bb: fixes the byte-backwards problem. It is passed a pointer to a    */
  66. /* sequence of 4 bytes read in from a file as bytes. It then converts those */
  67. /* bytes to represent a number. This code works for any machine, and makes  */
  68. /* the byte-code machine independent.                                       */
  69. /*                                        */
  70. /****************************************************************************/
  71.  
  72. void fix_bb(lptr)
  73. unsigned char *lptr;
  74. {
  75.     unsigned long *numptr;
  76.  
  77.     numptr = (unsigned long *)lptr;
  78.     *numptr = (((((*lptr << 8) | *(lptr+1)) 
  79.             << 8) | *(lptr+2)) 
  80.             << 8) | *(lptr+3);
  81.  
  82. }
  83.  
  84.  
  85. /****************************************************************************/
  86. /*                                        */
  87. /*    Load the file into permanent space, starting from "curr_fence".       */
  88. /* Data segment first (mixed psc entries and name strings), then text       */
  89. /* segment, ended with a virtual instruction "endfile <pointer>" where the  */
  90. /* pointer is a pointer to the next text segment (of another byte code      */
  91. /* file).                                    */
  92. /*                                        */
  93. /****************************************************************************/
  94.  
  95. int loader(file)
  96. char *file;
  97. { 
  98.   byte *restore;
  99.   int err_msg;
  100.  
  101.   fp = fopen(file, "r");
  102.   if ( fp == NULL ) return 10;
  103.   printf("\n     ...... loading file %s\n", file);
  104.  
  105.  
  106.   while ((eof_flag = get_data(&magic, 1)) == 0) { 
  107.     if (eof_flag = get_data(&psc_bytes, 1)) return ( 1 );
  108.     if (eof_flag = get_data(&text_bytes, 1)) return ( 1 );
  109.     if (eof_flag = get_data(&index_bytes, 1)) return ( 1 );
  110.     err_msg = load_syms() ;
  111.     if ( err_msg != 0 ) {
  112.     printf("error %d loading file %s\n", err_msg, file);
  113.     exit(1);   /* eventually upper level routines will determine */
  114.     }
  115.     else {
  116.     restore =  curr_fence;
  117.     err_msg = load_text(); 
  118.     if (err_msg != 0) {
  119.         printf("error %d loading file %s\n", err_msg, file);
  120.         curr_fence =  restore;
  121.         exit(1);  /* eventually upper level routines will determine */
  122.     } else {
  123.         err_msg = load_index();
  124.         if (err_msg != 0) {
  125.         printf("error in loading file %s\n", err_msg, file);
  126.         curr_fence = restore;
  127.         exit(1); /*eventually upper level routines will determine */
  128.         } else {
  129.         if (eof_flag = get_data(inst_addr, 6)) return (eof_flag);
  130.         if (*inst_addr != endfile)    *inst_addr = endfile;
  131.         inst_addr += 6;
  132.         *((pw)(inst_addr-4)) = 0;
  133.         last_text = inst_addr - 4;
  134.         curr_fence = inst_addr;
  135.         if (curr_fence > max_fence) quit("Program area overflow\n");
  136.         }
  137.     }
  138.     }
  139.   }
  140.   fclose(fp);
  141.   return 0;
  142. }
  143.  
  144.  
  145. /************************************************************************
  146. *                                                                       *
  147. * Load_syms is a function which loads a symbol table given in a byte    *
  148. * code file into an appropriate format in the pcs table.  As part of    *
  149. * its function it resolves entry points for byte code intructions (call *
  150. * to relloc_addr), and maintains a tableau so that instructions         *
  151. * with indexes into the psc table may have those indexex resloved before*
  152. * loading them in the intruction array (byte code program space).  The  *
  153. * intructions are loaded by a separate function.                        *
  154. * The function returns a short integer which is a error code.  Relevant *
  155. * error codes are listed below.                                         *
  156. *                                                                       *
  157. *      1: in load_syms: incomplete or missing psc count                 *
  158. *      2: in load_syms: incomplete or missing ep in record dec          *
  159. *      3: in load_syms: incomplete or missing arity in record dec       *
  160. *      4: in load_syms: incomplete or missing length in record dec      *
  161. *      5: in load_syms: incomplete or missing name in record dec        *
  162. *      8: can not open file                                             *
  163. *                                                                       *
  164. ************************************************************************/
  165.  
  166. int load_syms()
  167. {
  168.    char          name[256];
  169.    int               ep_offset;
  170.    byte     *reloc_addr( );
  171.    unsigned long     i, j, count;
  172.    byte     temp_len;
  173.    byte     temp_arity;
  174.    word *insert ( );
  175.  
  176.    i = 0; count = 0;
  177.    fix_bb(&psc_bytes); /* caller read psc_bytes, we just fix it */
  178.    while ( (count < psc_bytes) && (eof_flag == 0) ) {
  179.       if ( eof_flag = get_data(&ep_offset, 1) ) return(2);
  180.       fix_bb(&ep_offset);
  181.       if ( eof_flag = get_data(&temp_arity,1) ) return(3);
  182.       if ( eof_flag = get_data(&temp_len,1) ) return(4);
  183.       if ( eof_flag = get_data(name, temp_len) ) return(5);
  184.       reloc_table[i] = insert(name, temp_len, temp_arity, &perm);
  185.  
  186.       set_temp_ep(*reloc_table[i], ep_offset);
  187.       count += temp_len + 6; i++;
  188.    }
  189.    for (j = 0; j < i; j++) {
  190.       set_real_ep(*reloc_table[j], curr_fence);
  191.    }
  192.    pspace_used = ((int)curr_fence - (int)(pspace))/4;
  193.    return(0);
  194. }  /* load_syms */
  195.  
  196.  
  197.  
  198. /************************************************************************
  199. *                                                                       *
  200. *  Load_text loads the byte code intruction from a byte code file to    *
  201. *  the byte code program space.  References to indexes to the pcs table *
  202. *  are resolved with the use of the macro st_index.  New index  relies  *
  203. *  on the symbol table array which is assigned values by load_syms.     *
  204. *  The routine assumes the current length 8/18/84 of byte code          *
  205. *  intructions when reading from the byte code file.                    *
  206. * The function returns a short integer which is a error code.  Relevant *
  207. * error codes are listed below.                                         *
  208. *                                                                       *
  209. *      6: in load_text: byte code Operands are non-existent             *
  210. *      7: in load_text: Illegal instruction from PIL file               *
  211. *      8: can not open file                                             *
  212. *                                                                       *
  213. ************************************************************************/
  214.  
  215. int load_text ()
  216. {
  217.    long current_opcode = 0;
  218.    long count = 0;   
  219.    byte *reloc_addr( );
  220.  
  221. /* set text segments chain */
  222.    if (inst_begin == 0) { 
  223.         inst_begin = curr_fence;
  224.    } else *((word *)last_text) = (word)curr_fence;
  225.  
  226.    inst_addr = curr_fence;
  227.    fix_bb(&text_bytes);
  228.    while ( (count < text_bytes) &&
  229.        ((eof_flag = get_data(inst_addr, 1)) == 0) ) {
  230.        current_opcode = *(inst_addr++);
  231.        (*load_routine[parse_table[current_opcode]])();
  232.        count += inst_length[parse_table[current_opcode]];
  233.    }
  234.    if (count != text_bytes) return ( 9 ); /* missing instructions */
  235.    return(0);
  236.  
  237. }  /* load_text */
  238.  
  239. int load_index()
  240. {
  241.   long  psc_offset, clause_no, temp_len;
  242.   long  count = 0;
  243.   pw psc;
  244.   pb gen_index();
  245.  
  246.   fix_bb(&index_bytes);
  247.   while ( (count < index_bytes) && (eof_flag == 0) ) {
  248.       if (eof_flag = get_data(&psc_offset, 1)) return (10); 
  249.       fix_bb(&psc_offset);
  250.       psc = (pw)(*reloc_table[psc_offset]);
  251.       if (eof_flag = get_data(&clause_no, 1)) return (1);
  252.       fix_bb(&clause_no);
  253.       if (eof_flag = get_index_tab(clause_no, &temp_len)) return (eof_flag);
  254.       inst_addr = gen_index(clause_no, psc);
  255.       count += 8 + temp_len;
  256.   }
  257.   return (0);
  258. }
  259.  
  260. int get_index_tab(clause_no, lenptr)
  261.   long clause_no, *lenptr;
  262. {
  263.   long hashval, size, j;
  264.   long count = 0;
  265.   byte  type;
  266.   word val;
  267.   pb label, reloc_addr();
  268.  
  269.   hptr = (pb)hreg;
  270.   size = hsize(clause_no);
  271.   for (j = 0; j < size; j++) {
  272.       indextab[j].l = 0;
  273.       indextab[j].link = (pw)&(indextab[j].link);
  274.   }
  275.   for (j = 0; j< clause_no; j++) {
  276.       if (eof_flag = get_data(&type, 1)) return (11);
  277.          switch (type) {
  278.         case 'i': if (eof_flag = get_data(&val, 1)) return (12);
  279.               fix_bb(&val); count += 9;
  280.               break;
  281.         case 'l': val = *((pw)untagged(list_str)); 
  282.               /* val = untagged(list_str); */
  283.               count += 5;
  284.               break;
  285.             case 'n': /* val = untagged(nil_sym); */
  286.               val = *((pw)untagged(nil_sym));
  287.               count += 5;
  288.               break;
  289.         case 's': if (eof_flag = get_data(&val, 1)) return (12);
  290.               fix_bb(&val); count += 9;
  291.               val = *reloc_table[val];
  292.               /* val = (word)reloc_table[val]; */
  293.               break;
  294.         case 'c': if (eof_flag = get_data(&val, 1)) return (12);
  295.               fix_bb(&val); count += 9;
  296.               val = *reloc_table[val];
  297.               /* val = (word)reloc_table[val]; */
  298.               break; 
  299.      }
  300.          if (eof_flag = get_data(&label, 1)) return (13);
  301.      fix_bb(&label);
  302.          label = reloc_addr((long)label);
  303.          hashval = ihash(val, size);
  304.          inserth(label, &indextab[hashval]);
  305.   }
  306.   *lenptr = count;
  307.   return (0);
  308. }
  309.  
  310. byte *gen_index(clause_no, psc)
  311.   long clause_no;
  312.   struct psc_rec *psc;
  313. {
  314.   pb  ep1, ep2;
  315.   long j, size;
  316.   pw temp;
  317.  
  318.   size = hsize(clause_no);
  319.   ep1 = inst_addr;
  320.   *(ep1++) = hash; *(ep1++) = size;
  321.   ep2 = (inst_addr + 2 + 4 * size);
  322.   temp = (pw)(psc->ep + 2);         /* here the hash table size is */
  323.   *(temp++) = (long)inst_addr + 2;    /* computed and inserted into  */
  324.   *(temp) = size;            /* sob instructions           */
  325.   for (j = 0; j < size; j++) {
  326.       if (indextab[j].l == 0) {
  327.        *((pb *)ep1) = trap_vector[0]; ep1 += 4;
  328.       } else  if (indextab[j].l == 1) {
  329.        *((pw)ep1) = *(indextab[j].link); ep1 += 4;
  330.       } else {
  331.       /* otherwise create try/retry/trust instruction */
  332.       *((pb *)ep1) = ep2; ep1 += 4;
  333.       temp = (indextab[j].link);
  334.       gentry(try, psc->arity, *temp++, ep2);
  335.       while (*temp != (word)temp) {
  336.          temp = (pw)(*temp);
  337.          gentry(retry, psc->arity, *temp++, ep2);
  338.       }
  339.       *(ep2 - 6) = trust;
  340.       }
  341.   }
  342.   return (ep2);
  343.  
  344. }
  345.  
  346. inserth(label, bucket)
  347.   byte *label;
  348.   struct hrec *bucket;
  349. { 
  350.   pw temp;
  351.  
  352.   bucket->l++;
  353.   temp = (pw)&(bucket->link);
  354.   if (bucket->l > 1) {
  355.        temp = (pw)*temp;
  356.        while ((pw)*temp != temp) 
  357.           temp = (pw)*(++temp);
  358.   }
  359.   *temp = (word)hptr;
  360.   *((pb *)hptr) = label; hptr +=4;
  361.   *((pb *)hptr) = hptr; hptr += 4;
  362. }
  363.  
  364. int hsize(numentry)
  365.    long numentry;
  366. {  int i, j, temp;
  367.  
  368.    temp = numentry + 1;
  369.    hashsod:
  370.       j = temp / 2 + 1;
  371.       for (i = 2; i <= j; i++) {
  372.     if ((i != temp) && ((temp % i) == 0)) { temp++; goto hashsod;}
  373.       }
  374.       return ( temp );
  375. }
  376.  
  377. /************************************************************************
  378. *                                                                       *
  379. * Reloc_addr calculates the entry point of the code using the entry     *
  380. * point stored in the byte code file as an offset, and the stack        *
  381. * pointer curr_fence as the relative address.  Note trap vectors are    *
  382. * are indicated with a - 1, in the byte code file.                      *
  383. *                                                                       *
  384. ************************************************************************/
  385.  
  386.  
  387. byte *reloc_addr(offset)
  388.  
  389. long offset;
  390.  
  391. {
  392.    if ( offset >= 0 ) {
  393.       return curr_fence + offset;
  394.    }
  395.    else {
  396.       if ( -(offset+1) <= maxtraps ) {
  397.          return trap_vector[-(offset+1)];
  398.       }
  399.       else
  400.          return curr_fence + offset;   /* ??? */
  401.    }
  402. }  /* reloc_addr */
  403.  
  404.  
  405.  
  406.  
  407. int l_E()
  408. {
  409. }
  410.  
  411. int l_B()
  412. {
  413.              if ( get_data(inst_addr,1) ) 
  414.                 quit("incomplete instruction\n");
  415.              else inst_addr++;
  416. }
  417.  
  418. int l_PBB()
  419. {
  420.     /* operand 1 = 1 byte; operand 2 = 1 byte */
  421.              if ( get_data(inst_addr, 3) )
  422.              quit("incomplete instruction\n");
  423.              else  inst_addr += 3;
  424. }
  425.  
  426. int l_PW()
  427. {
  428.     /* operand 1 = 4 bytes index */
  429.              if ( get_data(inst_addr,5) ) 
  430.         quit("incomplete instruction\n"); 
  431.              else {
  432.         inst_addr++;
  433.         fix_bb(inst_addr);
  434.                 st_ptrpsc(inst_addr);
  435.                 inst_addr += 4;
  436.              }
  437. }
  438.  
  439. int l_PC()
  440. {
  441.     /* operand 1 = 4 bytes index */
  442.              if ( get_data(inst_addr,5) ) 
  443.         quit("incomplete instruction\n"); 
  444.              else {
  445.         inst_addr++;
  446.         fix_bb(inst_addr);
  447.                 st_ptrptrpsc(inst_addr);
  448.                 inst_addr += 4;
  449.              }
  450. }
  451.  
  452. int l_BW()
  453. {
  454.     /* operand 1 = 4 bytes index; operand 2 = 1 byte */
  455.              if ( get_data(inst_addr,5) ) 
  456.         quit("incomplete instruction\n"); 
  457.              else {
  458.            inst_addr++;
  459.                fix_bb(inst_addr);
  460.            st_ptrpsc(inst_addr);
  461.                inst_addr += 4;
  462.               }
  463. }
  464.  
  465. int l_BC()
  466. {
  467.     /* operand 1 = 4 bytes index; operand 2 = 1 byte */
  468.              if ( get_data(inst_addr,5) ) 
  469.         quit("incomplete instruction\n"); 
  470.              else {
  471.            inst_addr++;
  472.                fix_bb(inst_addr);
  473.            st_ptrptrpsc(inst_addr);
  474.                inst_addr += 4;
  475.               }
  476. }
  477.  
  478. int l_PA()
  479. {
  480.     /* operand 1 = 4 bytes address */
  481.              if ( get_data(inst_addr, 5) ) 
  482.         quit("incomplete instruction\n"); 
  483.              else {
  484.         inst_addr++;
  485.                 fix_bb(inst_addr);
  486.         *(pb *)inst_addr = reloc_addr(*(pw)inst_addr);
  487.                 inst_addr += 4;
  488.              }
  489. }
  490.  
  491. int l_PL()
  492. {
  493.     /* operand 1 = 4 bytes number */
  494.              if ( get_data(inst_addr, 5) ) 
  495.         quit("incomplete instruction\n"); 
  496.              else {
  497.              inst_addr++;
  498.          fix_bb(inst_addr);
  499.          inst_addr += 4;
  500.          }
  501. }
  502.  
  503. int l_BL()
  504. {
  505.     /* operand 1 = 4 bytes number; operand 2 = 1 byte reg */
  506.              if ( get_data(inst_addr, 5) ) 
  507.         quit("incomplete instruction\n");
  508.              else {
  509.              inst_addr++;
  510.          fix_bb(inst_addr);
  511.          inst_addr += 4;
  512.          }
  513. }
  514.  
  515.  
  516. int l_BA()
  517. {
  518.      /* operand 1 = 1 byte reg; operand 2 = 4 bytes address */
  519.              if ( get_data(inst_addr, 1) ) 
  520.         quit("incomplete instruction\n"); 
  521.              else {
  522.                 inst_addr++;
  523.                 if ( get_data(inst_addr, 4) ) 
  524.                     quit("incomplete instruction\n"); 
  525.                 else {
  526.            fix_bb(inst_addr);
  527.                    *(pb *)inst_addr = reloc_addr(*(pw)inst_addr);
  528.                    inst_addr += 4;
  529.                 }
  530.              }
  531. }
  532.  
  533.  l_BAA()
  534. {
  535.     /* oprnd1= 1 byte reg; oprnd1, oprnd2= 4 bytes addr */ 
  536.              if ( get_data(inst_addr, 1) ) 
  537.                  quit("incomplete instruction\n"); 
  538.              else {
  539.                  inst_addr++;
  540.                  if ( get_data(inst_addr, 4) ) 
  541.                      quit("incomplete instruction\n"); 
  542.                  else {
  543.             fix_bb(inst_addr);
  544.                     *(pb *)inst_addr = reloc_addr(*(pw)inst_addr);
  545.                     inst_addr += 4;
  546.                     if ( get_data(inst_addr, 4) ) 
  547.                         quit("incomplete instruction\n"); 
  548.                     else {
  549.                fix_bb(inst_addr);
  550.                        *(pb *)inst_addr = reloc_addr(*(pw)inst_addr);
  551.                        inst_addr += 4;
  552.             }
  553.                  }
  554.              }
  555. }
  556.  
  557. int l_P()
  558. {
  559.     /* only a pad byte, no operand */
  560.              if ( get_data(inst_addr, 1) ) 
  561.         quit("incomplete instruction\n"); 
  562.              else inst_addr++;
  563. }
  564.  
  565. int l_BBB()
  566. {
  567.     /* operand 1 = 1 byte; operand 2 = 1 byte; operand 3 = 1 byte */
  568.              if ( get_data(inst_addr, 3) )
  569.              quit("incomplete instruction\n");
  570.              else  inst_addr += 3;
  571. }
  572.  
  573. void init_load_routine()
  574. {
  575.     load_routine[E] = l_E;
  576.     load_routine[PBB] = l_PBB;
  577.     load_routine[BW] = l_BW;
  578.     load_routine[BC] = l_BC;
  579.     load_routine[B] = l_B;
  580.     load_routine[PW] = l_PW;
  581.     load_routine[PC] = l_PC;
  582.     load_routine[PL] = l_PL;
  583.     load_routine[BA] = l_BA;
  584.     load_routine[BAA] = l_BAA;
  585.     load_routine[PA] = l_PA;
  586.     load_routine[BL] = l_BL;
  587.     load_routine[P] = l_P;
  588.     load_routine[BBB] = l_BBB;
  589. }
  590.  
  591. int dyn_loader(psc_ptr)
  592. struct psc_rec *psc_ptr;
  593. {
  594.   extern char *getenv();
  595.   char s[256], s1[36], *s2, s3[256];
  596.   int i;
  597.  
  598.      namestring(psc_ptr, s1); printf("namestring returns %s\n",s1);
  599. if(loader(s1)==0) return(0);
  600. #ifdef AMIGA
  601.     /* if absolute path name then try to load
  602.     I define absolute path names for the Amiga
  603.     as    -has a device name(': present)
  604.         -does not start with parent '/'
  605.         -does not start with current directory '.'
  606.          */
  607.     if(index(s1,'!') && (*s1 != '.' && *s1 != '/'))
  608.     {printf("loading only %s\n",s1); return(loader(s1));}
  609. #endif
  610.      if (*s1 == '/') return loader(s1);
  611.      else 
  612.  
  613. #ifdef AMIGA /* chop off ./ for Amiga */
  614.      if(*s1 == '.' && strlen(s1) >2) return loader(&s1[2]);
  615. #else
  616.     if (*s1 == '.') return loader(s1);
  617. #endif
  618.  
  619.      else {
  620.     printf("using dynamic loader! %s\n", s1);
  621.     s2 = getenv("SIMPATH");
  622.  
  623.     while (1) {
  624.         while (*s2 == SEPARATOR || *s2 == ' ') s2++;
  625.         i = 0;
  626.         if (*s2 == '\0') {
  627. printf("file not found\n");
  628.          /* file not found */
  629.         return 1;
  630.         }
  631.         while (*s2 && *s2 != ' ' && *s2 != SEPARATOR) s[i++] = *(s2++);
  632.         printf("s is %s ",s);
  633.         s[i++] = '/';
  634.         s[i] = '\0';
  635.         scat(s, s1, s3);printf("trying to load %s\n",s3);
  636.         if (loader(s3) == 0) return 0;       
  637.     }
  638.     }
  639. }
  640.